home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 22 / AACD 22.iso / AACD / Programming / powerd / examples / RayTrace.d < prev    next >
Encoding:
Text File  |  2000-12-25  |  23.5 KB  |  929 lines
  1. // This example RayTraces an image and saves it in targa format as 24bit image
  2. // This example requires AGA and FPU
  3.  
  4. OPT    OPTIMIZE//,IEEE
  5.  
  6. MODULE    'intuition/intuition',
  7.             'intuition/screens',
  8.             'graphics/modeid',
  9.             'utility/tagitem'
  10. MODULE    'graphics/rastport'
  11. MODULE    'exec/memory',            // for saving
  12.             'dos/dos'
  13.  
  14. OBJECT Scene
  15.     Objects:PTR TO Object,
  16.     Lights:PTR TO Light,
  17.     Iar:FLOAT,                        // global ambient intensity
  18.     Iag:FLOAT,                        // global ambient intensity
  19.     Iab:FLOAT,                        // global ambient intensity
  20.     FogLength:FLOAT                // max visible distance in the fog
  21.  
  22. OBJECT Object
  23.     x:FLOAT,            // position for sphere, normal for plane
  24.     y:FLOAT,
  25.     z:FLOAT,
  26.     r:FLOAT,            // radius for sphere, offset for plane
  27.     ir:FLOAT,            // intensity (0-1)
  28.     ig:FLOAT,            // intensity (0-1)
  29.     ib:FLOAT,            // intensity (0-1)
  30.     ri:FLOAT,        // reflection intensity (0-1)
  31.     ra:FLOAT,        // ambient intensity (0-1)
  32.     h:UWORD,
  33.     type:UWORD,        // OT...
  34.     Next:PTR TO Object,
  35.     Surface:UWORD
  36.  
  37. OBJECT PolyObject
  38.     x:FLOAT,            // position for sphere, normal for plane
  39.     y:FLOAT,
  40.     z:FLOAT,
  41.     r:FLOAT,            // radius for sphere, offset for plane
  42.     ir:FLOAT,            // intensity (0-1)
  43.     ig:FLOAT,            // intensity (0-1)
  44.     ib:FLOAT,            // intensity (0-1)
  45.     ri:FLOAT,        // reflection intensity (0-1)
  46.     ra:FLOAT,        // ambient intensity (0-1)
  47.     h:UWORD,
  48.     type:UWORD,        // OT...
  49.     Next:PTR TO Object,
  50.     Surface:UWORD,
  51.     Poly:PTR TO Vector,
  52.     Count:LONG
  53.  
  54. OBJECT Light
  55.     x:FLOAT,
  56.     y:FLOAT,
  57.     z:FLOAT,
  58.     ir:FLOAT,            // intensity
  59.     ig:FLOAT,            // intensity
  60.     ib:FLOAT,            // intensity
  61.     Next:PTR TO Light
  62.  
  63. OBJECT Vector
  64.     x:FLOAT,
  65.     y:FLOAT,
  66.     z:FLOAT
  67.  
  68. OBJECT Vector2D
  69.     x:FLOAT,
  70.     y:FLOAT
  71.  
  72. OBJECT Line
  73.     x|x0:FLOAT,
  74.     y|y0:FLOAT,
  75.     z|z0:FLOAT,
  76.     u|vx:FLOAT,
  77.     v|vy:FLOAT,
  78.     w|vz:FLOAT
  79.  
  80. OBJECT Plane
  81.     a:FLOAT,
  82.     b:FLOAT,
  83.     c:FLOAT,
  84.     d:FLOAT
  85.  
  86. OBJECT Intersection
  87.     nx:FLOAT,                // normal
  88.     ny:FLOAT,
  89.     nz:FLOAT,
  90.     x:FLOAT,                    // position
  91.     y:FLOAT,
  92.     z:FLOAT,
  93.     t:FLOAT                    // parameter
  94.  
  95. OBJECT RGB
  96.     r:UBYTE,
  97.     g:UBYTE,
  98.     b:UBYTE
  99.  
  100. OBJECT BGR                    // for targa saving
  101.     b:UBYTE,
  102.     g:UBYTE,
  103.     r:UBYTE
  104.  
  105. OBJECT RImage
  106.     Width:LONG,
  107.     Height:LONG,
  108.     Pixel:PTR TO RGB,
  109.     ZBuffer:PTR TO FLOAT,
  110.     Antialias:PTR TO UBYTE
  111.  
  112. ENUM    OT_Sphere,
  113.         OT_IPlane,            // infinite
  114.         OT_PolyObject
  115.  
  116. ENUM    SURFACE_None,
  117.         SURFACE_Stripes,
  118.         SURFACE_Checks,
  119.         SURFACE_Dots
  120.  
  121. PROC Gen(image:PTR TO RImage,rp:PTR TO RastPort)
  122.     DEFF    x,y,scene:PTR TO Scene,o:PTR TO Object,l:PTR TO Light
  123.     DEFF    r,g,b
  124.     DEF    ds:DateStamp,ir,ig,ib
  125.     o:=[-100.0,-20.0,100.0, 20.0, 1.0,0.2,0.2, 0.0,0.1,6,OT_Sphere,NIL,SURFACE_None]:Object
  126.     o:=[ -60.0, 80.0, 80.0, 60.0, 0.8,0.7,0.6, 0.0,1.0,4,OT_Sphere,o,SURFACE_None]:Object
  127.     o:=[   0.0,  0.0,  0.0, 40.0, 0.6,0.7,0.8, 0.0,1.0,5,OT_Sphere,o,SURFACE_None]:Object
  128.     o:=[ 120.0,  0.0,  0.0, 30.0, 1.0,1.0,1.0, 0.8,0.4,3,OT_Sphere,o,SURFACE_None]:Object
  129.     o:=[ -40.0, 20.0,100.0, 15.0, 0.4,0.6,0.8, 0.6,0.2,7,OT_Sphere,o,SURFACE_None]:Object
  130.     o:=[  20.0, 40.0, 60.0, 25.0, 0.8,0.6,0.4, 0.2,0.3,5,OT_Sphere,o,SURFACE_None]:Object
  131.     o:=[   0.0, -1.0,  0.1, 80.0, 0.0,0.3,0.6, 0.0,0.5,4,OT_IPlane,o,SURFACE_Checks]:Object
  132. //    o:=[   0.0,  0.0,  1.0, 70.0, 0.3,0.3,0.2, 0.0,0.5,4,OT_PolyObject,o,SURFACE_Stripes,[0.0,-50.0,0.0,80.0,-60.0,0.0,100.0,100.0,0.0,-50.0,50.0,0.0]:Vector,4]:PolyObject
  133. /*
  134.     o:=[   0.0,  0.0,  0.0,  0.0, 1.0,1.0,1.0, 0.0,0.5,4,OT_PolyObject,o,SURFACE_Checks,
  135.             [-100.0, -60.0, 50.0,
  136.               -50.0, -60.0, 50.0,
  137.               -50.0, -10.0, 20.0,
  138.              -100.0, -10.0, 20.0]:Vector,4]:PolyObject
  139. */
  140. /*
  141.     o:=[   0.0,  1.0,  0.0,  0.0, 0.3,0.3,0.2, 0.0,0.5,4,OT_PolyObject,o,SURFACE_Checks,
  142.             [-100.0, -60.0,  0.0,
  143.               -50.0, -60.0,  0.0,
  144.               -50.0, -10.0,  0.0,
  145.              -100.0, -10.0,  0.0]:Vector,4]:PolyObject
  146. */
  147.     l:=[ -60.0, -40.0, 150.0,0.8,0.9,1.0,NIL]:Light
  148.     l:=[  80.0,   0.0,  20.0,0.5,0.2,1.0,l]:Light
  149.     l:=[  80.0,-250.0,-150.0,0.6,0.6,0.6,l]:Light
  150.     l:=[ 120.0, -50.0, 150.0,0.5,0.8,0.4,l]:Light
  151.     scene:=[o,l,0.0,0.0,0.0,10000.0]:Scene
  152.  
  153.     DateStamp(ds)
  154.     s_startday:=ds.Days
  155.     s_startmin:=ds.Minute
  156.     s_starttick:=ds.Tick
  157.  
  158.     FOR y:=-120.0 TO 119.0 STEP 1.0
  159.         FOR x:=-160.0 TO 159.0 STEP 1.0
  160.             r,g,b:=RayTrace(scene,[0.0,0.0,1000.0,x,y,-1000.0]:Line)
  161.             ir,ig,ib:=RPlot(image,x+160,y+120,r,g,b)
  162.             IF rp && (ir+ig+ib)>0
  163.                 SetAPen(rp,ir/4)
  164.                 WritePixel(rp,(x+160)*2,(y+120)*2)
  165.                 SetAPen(rp,ig/4+64)
  166.                 WritePixel(rp,(x+160)*2+1,(y+120)*2)
  167.                 SetAPen(rp,ib/4+128)
  168.                 WritePixel(rp,(x+160)*2,(y+120)*2+1)
  169.                 SetAPen(rp,(ir/4+ig/4+ib/4)/3+192)
  170.                 WritePixel(rp,(x+160)*2+1,(y+120)*2+1)
  171.             ENDIF
  172. //            IF x\10=0 THEN PrintF(' \d[3],\d[3]\b',x+160,y+120)
  173.         ENDFOR
  174.         IF Mouse()=3 THEN RETURN    // only to skip Antialias()
  175.         IF rp
  176.             SetAPen(rp,255)
  177.             WritePixel(rp,0,(y+120)*2)
  178.         ELSE PrintF('RayTracing: \d/\d\b',ir:=y+120,image.Height)
  179.     ENDFOR
  180.     IF rp=NIL THEN PrintF('\n')
  181.  
  182.     Antialias(rp,image,scene)
  183. /*
  184.     DEFF    c
  185.     c:=RayTrace(scene,[-10.0,0.0,1000.0,0.0,-30.0,-1000.0]:Line)
  186.     PrintF('fff: $\z\h[8]\n',c)
  187. */
  188. ENDPROC
  189.  
  190. // here follows global statistical variables
  191. DEFL    s_raycount=0,
  192.         s_interattemps=0,
  193.         s_intersections=0,
  194.         s_raysinfog=0,
  195.         s_reflectedrays=0,
  196.         s_antialias4=0,
  197.         s_antialias9=0,
  198.         s_antialias16=0,
  199.         s_antialias25=0,
  200.         s_startday,s_startmin,s_starttick,
  201.         s_stopday,s_stopmin,s_stoptick
  202.  
  203. PROC RayTrace(scene:PTR TO Scene,line:PTR TO Line,level=0)(FLOAT,FLOAT,FLOAT)
  204.     DEF    object:PTR TO Object,
  205.             zobj=NIL:PTR TO Object,
  206.             light:PTR TO Light
  207.     DEFF    Ivr=0.0,                        // vysledna intenzita
  208.             Ivg=0.0,
  209.             Ivb=0.0,
  210.             Is=0.0,                        // intenzita zrcadlove slozky
  211.             q,qr,qg,qb
  212.     DEFF    t,tott=1000000.0,
  213.             tobj=NIL:PTR TO Object,
  214.             inter:Intersection
  215.     DEF    shadow:BOOL,n
  216.     DEF    r:Vector,    // reflected vector
  217.             l:Vector        // vector light-point
  218.     s_raycount++
  219.     object:=scene.Objects
  220.     WHILE object
  221.         s_interattemps++
  222.         IF object.type=OT_Sphere
  223.             t:=IntersectSphere(NIL,line,object)
  224.         ELSEIF object.type=OT_IPlane
  225.             t:=IntersectPlane(NIL,line,object)
  226.         ELSEIF object.type=OT_PolyObject
  227.             t:=IntersectPolyObject(NIL,line,object)
  228.         ENDIF
  229. //        PrintF('001: $\z\h[8],$\z\h[8]\n',t,object.r)
  230.         IF t
  231.             IF t<tott
  232.                 tott:=t
  233.                 tobj:=object
  234.             ENDIF
  235.         ENDIF
  236.         object:=object.Next
  237.     ENDWHILE
  238.     IF scene.FogLength
  239.         IF tott>scene.FogLength
  240.             s_raysinfog++
  241.             RETURN scene.Iar,scene.Iag,scene.Iab
  242.         ENDIF
  243.     ENDIF
  244.     IF tobj
  245.         s_intersections++
  246.         IF tobj.type=OT_Sphere
  247.             IntersectSphere(inter,line,tobj)
  248.         ELSEIF tobj.type=OT_IPlane
  249.             IntersectPlane(inter,line,tobj)
  250.         ELSEIF tobj.type=OT_PolyObject
  251.             IntersectPolyObject(inter,line,tobj)
  252.         ENDIF
  253. //        PrintF('      t: $\z\h[8],$\z\h[8]\n',tott,tobj.r)
  254. //        PrintF('normala: $\z\h[8],$\z\h[8],$\z\h[8]\n',inter.nx,inter.ny,inter.nz)
  255. //        PrintF(' pozice: $\z\h[8],$\z\h[8],$\z\h[8]\n',inter.x,inter.y,inter.z)
  256.         light:=scene.Lights
  257.         WHILE light
  258.             l.x:=light.x-inter.x
  259.             l.y:=light.y-inter.y
  260.             l.z:=light.z-inter.z
  261.             shadow:=FALSE
  262.             object:=scene.Objects
  263.             WHILE object
  264.                 IF object<>tobj
  265.                     s_interattemps++
  266.                     IF object.type=OT_Sphere
  267.                         t:=IntersectSphere(NIL,[inter.x,inter.y,inter.z,l.x,l.y,l.z]:Line,object)
  268.                     ELSEIF object.type=OT_IPlane
  269.                         t:=IntersectPlane(NIL,[inter.x,inter.y,inter.z,l.x,l.y,l.z]:Line,object)
  270.                     ELSEIF object.type=OT_PolyObject
  271.                         t:=IntersectPolyObject(NIL,[inter.x,inter.y,inter.z,l.x,l.y,l.z]:Line,object)
  272.                     ENDIF
  273. //                    PrintF('r $\z\h[8],$\z\h[8]\n',t,object.r)
  274.                     IF t
  275.                         s_intersections++
  276.                         shadow:=TRUE
  277.                     ENDIF
  278.                 ENDIF
  279.                 object:=object.Next
  280.             EXITIF shadow=TRUE
  281.             ENDWHILE
  282. //            PrintF('n')
  283. //            PrintF('normala: $\z\h[8],$\z\h[8],$\z\h[8],\d\n',inter.nx,inter.ny,inter.nz,shadow)
  284.             IF shadow=FALSE
  285.                 IF (q:=VectorAngle(inter,l))>0.0
  286. //                    PrintF('surface: $\z\h[8],$\z\h[8],$\z\h[8],\d\n',inter.x,inter.y,inter.z,shadow)
  287.                     qr,qg,qb:=Surface(tobj.Surface,inter.x,inter.y,inter.z,tobj.ir,tobj.ig,tobj.ib)
  288. //                    PrintF('colours: $\z\h[8],$\z\h[8],$\z\h[8],\d\n',qr,qg,qb,shadow)
  289.                     Ivr+=light.ir*q*qr
  290.                     Ivg+=light.ig*q*qg
  291.                     Ivb+=light.ib*q*qb
  292.                 ENDIF
  293.                 Reflect3D(r,inter,l)
  294.                 IF (q:=VectorAngle(r,[line.u,line.v,line.w]:Vector))>0.0
  295.                     IF tobj.h>1
  296.                         FOR n:=1 TO tobj.h
  297.                             q*=q
  298.                         ENDFOR
  299.                     ENDIF
  300.                     Ivr+=light.ir*q
  301.                     Ivg+=light.ig*q
  302.                     Ivb+=light.ib*q
  303.                 ENDIF
  304.             ENDIF
  305.             light:=light.Next
  306.         ENDWHILE
  307. //        PrintF('intensity: $\z\h[8],$\z\h[8]\n',Ivr,tobj.r)
  308.         IF level<4
  309. //            PrintF(' object: $\z\h[8],$\z\h[8]\n',tobj.ri,tobj.r)
  310.             IF tobj.ri
  311.                 s_reflectedrays++
  312.                 Reflect3D(r,inter,[line.u,line.v,line.w]:Vector)
  313.                 qr,qg,qb:=RayTrace(scene,[inter.x,inter.y,inter.z,r.x,r.y,r.z]:Line,level+1)
  314.                 Ivr:=Ivr*(1.0-tobj.ri)/1.0+tobj.ri*qr/1.0
  315.                 Ivg:=Ivg*(1.0-tobj.ri)/1.0+tobj.ri*qg/1.0
  316.                 Ivb:=Ivb*(1.0-tobj.ri)/1.0+tobj.ri*qb/1.0
  317. //                PrintF('reflect: $\z\h[8],$\z\h[8]\n',q,Ivr)
  318.             ENDIF
  319.         ENDIF
  320. //        PrintF('intensity: $\z\h[8],$\z\h[8]\n',Ivr,tobj.r)
  321. //        PrintF('surface2: $\z\h[8],$\z\h[8],$\z\h[8],\d\n',inter.x,inter.y,inter.z,shadow)
  322.         qr,qg,qb:=Surface(tobj.Surface,inter.x,inter.y,inter.z,tobj.ir,tobj.ig,tobj.ib)
  323. //        PrintF('colours2: $\z\h[8],$\z\h[8],$\z\h[8],\d\n',qr,qg,qb,tobj.r)
  324.         Ivr+=scene.Iar*qr*tobj.ra
  325.         Ivg+=scene.Iag*qg*tobj.ra
  326.         Ivb+=scene.Iab*qb*tobj.ra
  327.         IF Ivr>1.0 THEN Ivr:=1.0
  328.         IF Ivr<0.0 THEN Ivr:=0.0
  329.         IF Ivg>1.0 THEN Ivg:=1.0
  330.         IF Ivg<0.0 THEN Ivg:=0.0
  331.         IF Ivb>1.0 THEN Ivb:=1.0
  332.         IF Ivb<0.0 THEN Ivb:=0.0
  333.         IF scene.FogLength
  334.             q:=tott/scene.FogLength
  335.             Ivr:=scene.Iar*q+Ivr*(1.0-q)
  336.             Ivg:=scene.Iag*q+Ivg*(1.0-q)
  337.             Ivb:=scene.Iab*q+Ivb*(1.0-q)
  338.         ENDIF
  339.         RETURN Ivr,Ivg,Ivb
  340.     ELSE
  341.         s_raysinfog++
  342.         RETURN scene.Iar,scene.Iag,scene.Iab
  343.     ENDIF
  344. ENDPROC 1.0,1.0,1.0
  345.  
  346. PROC VectorAngle(a:PTR TO Vector,b:PTR TO Vector)(FLOAT)
  347.     DEFF    r
  348. //    r:=(a.x*b.x+a.y*b.y+a.z*b.z)/(Sqrt(a.x*a.x+a.y*a.y+a.z*a.z)*Sqrt(b.x*b.x+b.y*b.y+b.z*b.z))
  349.     r:=(a.x*b.x+a.y*b.y+a.z*b.z)/(Sqrt((a.x*a.x+a.y*a.y+a.z*a.z)*(b.x*b.x+b.y*b.y+b.z*b.z)))
  350. ENDPROC r
  351.  
  352. PROC VectorSize(a:PTR TO Vector)(FLOAT)
  353.     DEFF    r
  354.     r:=Sqrt(a.x*a.x+a.y*a.y+a.z*a.z)
  355. ENDPROC r
  356.  
  357. PROC ResizeVector(a:PTR TO Vector,l:FLOAT)
  358.     DEFF    d
  359.     d:=l/VectorSize(a)
  360. //    PrintF('$\z\h[8]\n',d)
  361.     a.x*=d
  362.     a.y*=d
  363.     a.z*=d
  364. ENDPROC
  365.  
  366. PROC LineDistance(line:PTR TO Line,point:PTR TO Vector)(FLOAT)
  367.     DEFF    plane:Plane,d,inter:Vector
  368.     plane.a:=line.vx                                // vytvoreni roviny kolme na danou primku
  369.     plane.b:=line.vy
  370.     plane.c:=line.vz
  371.     plane.d:=point.x*plane.a+point.y*plane.b+point.z*plane.c
  372.     plane.d:=-plane.d
  373. //    PrintF('$\z\h[8],$\z\h[8],$\z\h[8],$\z\h[8]\n',plane.a,plane.b,plane.c,plane.d)
  374.     PlaneIntersection(inter,line,plane)
  375. //    PrintF('$\z\h[8],$\z\h[8],$\z\h[8]\n',inter.x,inter.y,inter.z)
  376.     d:=PointDistance(inter,point)
  377. //    PrintF('$\z\h[8]\n',d)
  378. ENDPROC d
  379.  
  380. // tato funkce vypocita vzdalenost bodu od plochy v prostoru
  381. PROC PlaneDistance(plane:PTR TO Plane,point:PTR TO Vector)(FLOAT)
  382.     DEFF    a,b,c,d
  383.     a:=plane.a
  384.     b:=plane.b
  385.     c:=plane.c
  386.     d:=Sqrt(a*a+b*b+c*c)
  387.     IF d
  388.         d:=FAbs(a*point.x+b*point.y+c*point.z+plane.d)/d
  389.     ENDIF
  390. ENDPROC d
  391.  
  392. // tato funkce vypocita prusecik plochy a primky v prostoru
  393. PROC PlaneIntersection(dst:PTR TO Vector,line:PTR TO Line,plane:PTR TO Plane)(FLOAT,FLOAT,FLOAT)
  394.     DEFF    x,y,z,t,a,b,c
  395.     a:=plane.a
  396.     b:=plane.b
  397.     c:=plane.c
  398.     t:=(a*line.u+b*line.v+c*line.w)
  399. //    PrintF('$\z\h[8],$\z\h[8],$\z\h[8]\n',a,b,c)
  400.     IF t
  401.         t:=-(a*line.x0+b*line.y0+c*line.z0+plane.d)/t
  402.     ENDIF
  403.     x:=line.x0+line.u*t
  404.     y:=line.y0+line.v*t
  405.     z:=line.z0+line.w*t
  406. //    PrintF('$\z\h[8]\n',t)
  407. //    PrintF('$\z\h[8],$\z\h[8],$\z\h[8]\n',x,y,z)
  408.     IF dst
  409.         dst.x:=x
  410.         dst.y:=y
  411.         dst.z:=z
  412.     ENDIF
  413. ENDPROC x,y,z
  414.  
  415. // tatu funkce vraci parametr, na kterem dochazi k pruniku
  416. PROC PlaneIntersectionParameter(line:PTR TO Line,plane:PTR TO Plane)(FLOAT)
  417.     DEFF    t,a,b,c
  418.     a:=plane.a
  419.     b:=plane.b
  420.     c:=plane.c
  421. //    PrintF('a,b,c: $\z\h[8],$\z\h[8],$\z\h[8]\n',a,b,c)
  422.     t:=(a*line.u+b*line.v+c*line.w)
  423. //    PrintF('t1: $\z\h[8]\n',t)
  424.     IF t
  425. //        PrintF('t2: $\z\h[8]\n',t)
  426.         t:=-(a*line.x0+b*line.y0+c*line.z0+plane.d)/t
  427.         IF t<=0.0 THEN RETURN 0.0
  428.     ENDIF
  429. ENDPROC t
  430.  
  431. // tato funkce vypocita vzdalenost mezi dvema body v prostoru
  432. PROC PointDistance(a:PTR TO Vector,b:PTR TO Vector)(FLOAT)
  433.     DEFF    d,x,y,z
  434.     x:=b.x-a.x
  435.     y:=b.y-a.y
  436.     z:=b.z-a.z
  437.     d:=Sqrt(x*x+y*y+z*z)
  438. ENDPROC d
  439.  
  440. // tato funkce vypocita odrazeny vektor l podle normaly
  441. PROC Reflect3D(r:PTR TO Vector,n:PTR TO Vector,l:PTR TO Vector)(FLOAT,FLOAT,FLOAT)
  442.     DEFF    x,y,z,a
  443.     ResizeVector(n,1.0)
  444.     ResizeVector(l,1.0)
  445.     a:=2.0*(n.x*l.x+n.y*l.y+n.z*l.z)
  446.     x:=l.x-n.x*a
  447.     y:=l.y-n.y*a
  448.     z:=l.z-n.z*a
  449.     IF r
  450.         r.x:=x
  451.         r.y:=y
  452.         r.z:=z
  453.     ENDIF
  454. ENDPROC x,y,z
  455.  
  456. PROC IntersectSphere(inter:PTR TO Intersection,line:PTR TO Line,object:PTR TO Object)(FLOAT)
  457.     DEFF    d,t,plane:Plane,vector:Vector,l
  458.     d:=LineDistance(line,object)    // pozor, "object" je v tomto pripade to same jako bod
  459.     IF d<=object.r
  460.         // ano, koule je protnuta primkou
  461.         plane.a:=line.vx                                // vytvoreni roviny kolme na danou primku
  462.         plane.b:=line.vy
  463.         plane.c:=line.vz
  464.         plane.d:=object.x*plane.a+object.y*plane.b+object.z*plane.c
  465.         plane.d:=-plane.d
  466.         t:=PlaneIntersectionParameter(line,plane)
  467. //        PrintF('t=$\z\h[8]\n',t)
  468.         IF t>0.0
  469.             vector.x:=line.u*t
  470.             vector.y:=line.v*t
  471.             vector.z:=line.w*t
  472. //            PrintF(' vektor: $\z\h[8],$\z\h[8],$\z\h[8]\n',vector.x,vector.y,vector.z)
  473. //            PrintF('d $\z\h[8],$\z\h[8]\n',d,object.r)
  474.             l:=Sqrt(object.r*object.r-d*d)        // vzdalenost kraje koule po dane primce od bodu nejblizsiho ke stredu
  475. //            PrintF('l $\z\h[8],$\z\h[8]\n',l,object.r)
  476.             l:=VectorSize(vector)-l
  477. //            PrintF('l2$\z\h[8],$\z\h[8]\n',l,object.r)
  478.             IF inter
  479.                 ResizeVector(vector,l)
  480. //                PrintF('vektorP: $\z\h[8],$\z\h[8],$\z\h[8]\n',vector.x,vector.y,vector.z)
  481.                 inter.x:=vector.x+line.x0
  482.                 inter.y:=vector.y+line.y0
  483.                 inter.z:=vector.z+line.z0
  484. //                PrintF('  inter: $\z\h[8],$\z\h[8],$\z\h[8]\n',inter.x,inter.y,inter.z)
  485. //                PrintF(' objekt: $\z\h[8],$\z\h[8],$\z\h[8]\n',object.x,object.y,object.z)
  486.                 inter.t:=l
  487.                 inter.nx:=inter.x-object.x
  488.                 inter.ny:=inter.y-object.y
  489.                 inter.nz:=inter.z-object.z
  490. //                PrintF('normala: $\z\h[8],$\z\h[8],$\z\h[8]\n',inter.nx,inter.ny,inter.nz)
  491.             ENDIF
  492.             IF l>0.0 THEN RETURN l
  493.         ENDIF
  494.     ENDIF
  495. ENDPROC 0.0
  496.  
  497. PROC IntersectPlane(inter:PTR TO Intersection,line:PTR TO Line,object:PTR TO Object)(FLOAT)
  498.     DEFF    t,plane:Plane,vector:Vector,l
  499.     plane.a:=object.x
  500.     plane.b:=object.y
  501.     plane.c:=object.z
  502.     plane.d:=object.r
  503. //    PrintF('Yes: ')
  504.     t:=PlaneIntersectionParameter(line,plane)
  505. //    PrintF('Param: $\z\h[8]\n',t)
  506.     IF t>0.0
  507. //        PrintF('Yes($\z\h[8])\n',inter)
  508.         vector.x:=line.u
  509.         vector.y:=line.v
  510.         vector.z:=line.w
  511.         l:=VectorSize(vector)
  512.         IF inter
  513.             vector.x:=line.u*t
  514.             vector.y:=line.v*t
  515.             vector.z:=line.w*t
  516. //            ResizeVector(vector,l)
  517.             inter.x:=vector.x+line.x0
  518.             inter.y:=vector.y+line.y0
  519.             inter.z:=vector.z+line.z0
  520.             inter.t:=t*l
  521.             inter.nx:=object.x
  522.             inter.ny:=object.y
  523.             inter.nz:=object.z
  524.         ENDIF
  525.         t*=l
  526.     ELSE
  527.         t:=0.0
  528.     ENDIF
  529. ENDPROC t
  530. /*
  531. PROC IntersectPolyObject(inter:PTR TO Intersection,line:PTR TO Line,object:PTR TO PolyObject)(FLOAT)
  532.     DEFF    t
  533.     IF object.x=0.0 AND object.y=0.0 AND object.z=0.0
  534.         NormalVector(object,object.Poly[0],object.Poly[1],object.Poly[2])
  535.         object.r:=object.Poly[0].x*object.x*object.Poly[0].y*object.y*object.Poly[0].z*object.z
  536.     ENDIF
  537.     t:=IntersectPlane(inter,line,object)
  538.     IF t>0.0
  539.         IF IsPointInPoly(inter.x,inter.y,object.Poly,4)=FALSE THEN t:=0.0
  540.     ENDIF
  541. ENDPROC t
  542.  
  543. PROC NormalVector(dest:PTR TO Vector,a:PTR TO Vector,b:PTR TO Vector,c:PTR TO Vector)
  544.     DEF    d=[a.x-b.x,a.y-b.y,a.z-b.z]:Vector,
  545.             e=[c.x-b.x,c.y-b.y,c.z-b.z]:Vector
  546.     dest.x:=d.y*e.z-d.z*e.y
  547.     dest.y:=d.z*e.x-d.x*e.z
  548.     dest.z:=d.x*e.y-d.y*e.x
  549. ENDPROC
  550. */
  551. PROC IntersectPolyObject(inter:PTR TO Intersection,line:PTR TO Line,object:PTR TO PolyObject)(FLOAT)
  552.     DEFF    t,plane:Plane,vector:Vector,l,point:Vector
  553.     plane.a:=object.x
  554.     plane.b:=object.y
  555.     plane.c:=object.z
  556.     plane.d:=object.r
  557. //    PrintF('Yes: ')
  558.     t:=PlaneIntersectionParameter(line,plane)
  559. //    PrintF('Param: $\z\h[8]\n',t)
  560.     IF t>0.0
  561.         vector.x:=line.u
  562.         vector.y:=line.v
  563.         vector.z:=line.w
  564.         l:=VectorSize(vector)
  565.         vector.x:=line.u*t
  566.         vector.y:=line.v*t
  567.         vector.z:=line.w*t
  568.         point.x:=vector.x+line.x0        // bod pruniku primky plochou
  569.         point.y:=vector.y+line.y0
  570.         point.z:=vector.z+line.z0
  571. //        PrintF('Pos: $\z\h[8],$\z\h[8]\n',line.u,line.v)
  572. //        IF IsPointInPoly(line.u,line.v,object.Poly,object.Count)=1
  573.         IF IsPointInPoly(point.x,point.y,object.Poly,object.Count)=1
  574. //            PrintF('Yes($\z\h[8])\n',l)
  575.             IF inter
  576.                 inter.x:=point.x
  577.                 inter.y:=point.y
  578.                 inter.z:=point.z
  579.                 inter.t:=t*l
  580.                 inter.nx:=object.x
  581.                 inter.ny:=object.y
  582.                 inter.nz:=object.z
  583.             ENDIF
  584.             t*=l
  585.         ELSE
  586.             t:=0.0
  587.         ENDIF
  588.     ELSE
  589.         t:=0.0
  590.     ENDIF
  591. ENDPROC t
  592.  
  593. // tahle funkce je vyrizla z AmiRaye a upravena
  594. PROC IsPointInPoly(x:FLOAT,y:FLOAT,p:PTR TO Vector,count)(BOOL)
  595.     DEF    n=0,e=0
  596.     DEFF    ys,x1,y1,x2,y2
  597.  
  598. //    PrintF('X,Y,C: $\z\h[8],$\z\h[8],\d\n',x,y,count)
  599.  
  600.     WHILE n<count
  601.         x1:=p[n].x
  602.         y1:=p[n].y
  603. //        PrintF('X1,Y2: $\z\h[8],$\z\h[8]\n',x1,y1)
  604.         IF n=(count-1)
  605.             x2:=p[0].x
  606.             y2:=p[0].y
  607.         ELSE
  608.             x2:=p[n+1].x
  609.             y2:=p[n+1].y
  610.         ENDIF
  611.  
  612.         IF (x1<=x AND x2>x) OR (x1>x AND x2<=x)
  613.         // x coord is between the two points
  614.             IF y1<=y AND y2<=y
  615.                 e++            // yes, there is line above the point
  616.             ELSEIF (y1<y AND y2>y) OR (y1>y AND y2<y)
  617.             // y coord is between the two points
  618.                 ys:=(x-x1)*((y2-p[n].y)/(x2-x1))+p[n].y
  619.                 IF ys<y THEN e++
  620.             ENDIF
  621.         ENDIF
  622.  
  623.         n++
  624.     ENDWHILE
  625. //    PrintF('Yes=\d\n',e)
  626. ENDPROC e&1
  627.  
  628. PROC Antialias(rp:PTR TO RastPort,image:PTR TO RImage,scene:PTR TO Scene)
  629.     DEFF    x,y,d,r,g,b
  630.     DEF    a:PTR TO UBYTE,n,i,j,ax,ay,ir,ig,ib
  631.     IF a:=FindSharp(rp,image)
  632.         ay:=0
  633.         FOR y:=-120.0 TO 119.0 STEP 1.0
  634.             ax:=0
  635.             FOR x:=-160.0 TO 159.0 STEP 1.0
  636.                 n:=a[ay*320+ax]
  637.                 IF n
  638.                     d:=1.0/(n+1.0)
  639.                     r:=g:=b:=0.0
  640.                     FOR j:=0 TO n
  641.                         FOR i:=0 TO n
  642.                             r,g,b+=RayTrace(scene,[i*d,j*d,1000.0,x,y,-1000.0]:Line)
  643.                         ENDFOR
  644.                     ENDFOR
  645.                     d:=1.0/((n+1.0)*(n+1.0))
  646.                     r*=d
  647.                     g*=d
  648.                     b*=d
  649.                     ir,ig,ib:=RPlot(image,ax,ay,r,g,b)
  650.                     IF rp
  651.                         SetAPen(rp,ir/4)
  652.                         WritePixel(rp,(x+160)*2,(y+120)*2)
  653.                         SetAPen(rp,ig/4+64)
  654.                         WritePixel(rp,(x+160)*2+1,(y+120)*2)
  655.                         SetAPen(rp,ib/4+128)
  656.                         WritePixel(rp,(x+160)*2,(y+120)*2+1)
  657.                         SetAPen(rp,(ir/4+ig/4+ib/4)/3+192)
  658.                         WritePixel(rp,(x+160)*2+1,(y+120)*2+1)
  659. /*
  660.                         SetAPen(rp,ir>>2)
  661.                         WritePixel(rp,ax<<1,ay<<1)
  662.                         SetAPen(rp,ig>>2+64)
  663.                         WritePixel(rp,ax<<1+1,ay<<1)
  664.                         SetAPen(rp,ib>>2+128)
  665.                         WritePixel(rp,ax<<1,ay<<1+1)
  666.                         SetAPen(rp,(ir>>2+ig>>2+ib>>2)/3+192)
  667.                         WritePixel(rp,ax<<1+1,ay<<1+1)
  668. */
  669.                     ENDIF
  670.                 ENDIF
  671.                 ax++
  672.             ENDFOR
  673.             ay++
  674.             IF rp
  675.             ELSE PrintF('Antialiasing: \d/\d\b',ay,image.Height)
  676.         EXITIF Mouse()=3
  677.         ENDFOR
  678.         FreeVec(a)
  679.     ENDIF
  680.     IF rp=NIL THEN PrintF('\n')
  681. ENDPROC
  682.  
  683. PROC FindSharp(rp:PTR TO RastPort,image:PTR TO RImage)(PTR TO UBYTE)
  684.     DEF    x,y,c,a:PTR TO UBYTE
  685.     IF a:=AllocVec(320*240,MEMF_PUBLIC|MEMF_CLEAR)
  686.         DEF    min,max,dx,dy
  687.         IF rp THEN SetAPen(rp,255)
  688.         FOR y:=1 TO 238
  689.             FOR x:=1 TO 318
  690.                 min:=255
  691.                 max:=0
  692.                 FOR dy:=-1 TO 1
  693.                     FOR dx:=-1 TO 1
  694.                         c:=RGet(image,x+dx,y+dy)
  695.                         IF c<min THEN min:=c
  696.                         IF c>max THEN max:=c
  697.                     ENDFOR
  698.                 ENDFOR
  699.                 c:=max-min
  700.                 IF c>100
  701.                     c:=4
  702.                     s_antialias25++
  703.                 ELSEIF c>50
  704.                     c:=3
  705.                     s_antialias16++
  706.                 ELSEIF c>25
  707.                     c:=2
  708.                     s_antialias9++
  709.                 ELSEIF c>8
  710.                     c:=1
  711.                     s_antialias4++
  712.                 ELSE
  713.                     c:=0
  714.                 ENDIF
  715.                 IF rp
  716.                     IF c
  717. //                        SetAPen(rp,c*10+200)
  718.                         WritePixel(rp,x*2,y*2)
  719.                     ENDIF
  720.                 ENDIF
  721.                 a[y*320+x]:=c
  722.             ENDFOR
  723.         EXITIF Mouse()=3
  724.         ENDFOR
  725.     ENDIF
  726. ENDPROC a
  727.  
  728. PROC SaveTarga(image:PTR TO RImage)
  729.     DEF    buff:PTR TO BGR,f,x,y,length,comment:PTR TO CHAR
  730.     PrintF('Saving...           \n')
  731.     IF buff:=AllocMem(image.Width*image.Height*SIZEOF_BGR,MEMF_PUBLIC)
  732.         FOR y:=0 TO image.Height-1
  733.             FOR x:=0 TO image.Width-1
  734.                 buff[y*image.Width+x].r:=image.Pixel[y*image.Width+x].r
  735.                 buff[y*image.Width+x].g:=image.Pixel[y*image.Width+x].g
  736.                 buff[y*image.Width+x].b:=image.Pixel[y*image.Width+x].b
  737.             ENDFOR
  738.         ENDFOR
  739.         IF f:=Open('ram:image.tga',MODE_NEWFILE)
  740.             comment:='$VER:This picture is generated by Martin Kuchinka''s simple RayTracer.'
  741.             length:=StrLen(comment)
  742.             Write(f,[length,0,2,0,0,0,0,24,0,0,0,0,image.Width,image.Width>>8,image.Height,image.Height>>8,24,$20]:UBYTE,18)
  743.             Write(f,comment,length)
  744.             Write(f,buff,image.Width*image.Height*SIZEOF_BGR)
  745.             Close(f)
  746.         ELSE PrintF('Unable to write image!\n')
  747.         FreeMem(buff,image.Width*image.Height*SIZEOF_BGR)
  748.     ELSE PrintF('Not enough memory!\n')
  749. ENDPROC
  750.  
  751. PROC Surface(s,x:FLOAT,y:FLOAT,z:FLOAT,r:FLOAT,g:FLOAT,b:FLOAT)(FLOAT,FLOAT,FLOAT)
  752.     DEFF    l
  753.     SELECT s
  754.     CASE SURFACE_Stripes
  755.         y\=50
  756.         IF y<0
  757.             y:=FAbs(y)
  758.             IF y<25
  759.                 r/=2
  760.                 g/=2
  761.                 b/=2
  762.             ENDIF
  763.         ELSE
  764.             IF y>25
  765.                 r/=2
  766.                 g/=2
  767.                 b/=2
  768.             ENDIF
  769.         ENDIF
  770.     CASE SURFACE_Checks
  771. //        PrintF('x,z: $\z\h[8],$\z\h[8]\n',x,z)
  772.         x\=100
  773.         z\=100
  774.         IF x<0
  775.             x:=-x
  776.             IF z<0
  777.                 z:=-z
  778.                 IF (x>50 AND z>50) OR (x<50 AND z<50)
  779.                     r/=2
  780.                     g/=2
  781.                     b/=2
  782.                 ENDIF
  783.             ELSE
  784.                 IF (x>50 AND z<50) OR (x<50 AND z>50)
  785.                     r/=2
  786.                     g/=2
  787.                     b/=2
  788.                 ENDIF
  789.             ENDIF
  790.         ELSE
  791.             IF z<0
  792.                 z:=-z
  793.                 IF (x<50 AND z>50) OR (x>50 AND z<50)
  794.                     r/=2
  795.                     g/=2
  796.                     b/=2
  797.                 ENDIF
  798.             ELSE
  799.                 IF (x<50 AND z<50) OR (x>50 AND z>50)
  800.                     r/=2
  801.                     g/=2
  802.                     b/=2
  803.                 ENDIF
  804.             ENDIF
  805.         ENDIF
  806.     CASE SURFACE_Dots
  807.         x\=100
  808.         y\=100
  809.         z\=100
  810.         x-=50
  811.         y-=50
  812.         z-=50
  813.         l:=Sqrt(x*x+z*z)
  814.         IF l<25
  815.             r/=2
  816.             g/=2
  817.             b/=2
  818.         ENDIF
  819.     ENDSELECT
  820. ENDPROC r,g,b
  821.  
  822. PROC NewImage(w,h)(PTR TO RImage)
  823.     DEF    image:PTR TO RImage
  824.     IF (image:=AllocMem(SIZEOF_RImage,MEMF_PUBLIC|MEMF_CLEAR))=NIL THEN RETURN NIL
  825.     image.Width:=w
  826.     image.Height:=h
  827.     IF (image.Pixel:=AllocMem(SIZEOF_RGB*w*h,MEMF_PUBLIC|MEMF_CLEAR))=NIL
  828.         FreeMem(image,SIZEOF_RImage)
  829.         RETURN NIL
  830.     ENDIF
  831. ENDPROC image
  832.  
  833. PROC RPlot(image:PTR TO RImage,x,y,r:FLOAT,g:FLOAT,b:FLOAT/*,z=0.0:FLOAT*/)(LONG,LONG,LONG)
  834.     DEFF    pixel:PTR TO RGB
  835.     r*=255
  836.     g*=255
  837.     b*=255
  838.     pixel:=image.Pixel[y*image.Width+x]
  839.     pixel.r:=r
  840.     pixel.g:=g
  841.     pixel.b:=b
  842. /*
  843.     IF image.ZBuffer
  844.         image.ZBuffer[y*image.Width+x]:=z
  845.     ENDIF
  846. */
  847. ENDPROC r,g,b
  848.  
  849. PROC RGet(image:PTR TO RImage,x,y)(LONG)
  850. //    DEF    c
  851. //    c:=image.Pixel[y*image.Width+x].r+image.Pixel[y*image.Width+x].g+image.Pixel[y*image.Width+x].b
  852.  
  853.     DEF    c,pixel:PTR TO RGB
  854.     pixel:=image.Pixel[y*image.Width+x]
  855.     c:=(pixel.r+pixel.g+pixel.b)/3
  856. ENDPROC c
  857.  
  858. PROC DeleteImage(image:PTR TO RImage)
  859.     IF image.Pixel THEN FreeMem(image.Pixel,image.Width*image.Height*SIZEOF_RGB)
  860.     FreeMem(image,SIZEOF_RImage)
  861. ENDPROC
  862.  
  863. PROC ShowInfo()
  864.     DEFF    f
  865.     DEF    str[24]:CHAR,ds:DateStamp,sec
  866.     DateStamp(ds)
  867.     s_stopday:=ds.Days
  868.     s_stopmin:=ds.Minute
  869.     s_stoptick:=ds.Tick
  870.     IF s_startday=s_stopday
  871.         sec:=s_stopmin*60+s_stoptick/50-s_startmin*60-s_starttick/50
  872.     ENDIF
  873.     PrintF('           Total rays: \d\n',s_raycount)
  874.     PrintF('       Reflected rays: \d\n',s_reflectedrays)
  875.     PrintF(' Intersection attemps: \d\n',s_interattemps)
  876.     PrintF('        Intersections: \d\n',s_intersections)
  877.     PrintF('     Rays lost in fog: \d\n',s_raysinfog)
  878.     PrintF('   Antialiased pixels:\n')
  879.     PrintF('       \d[2]x recomputed: \d\n',4,s_antialias4)
  880.     PrintF('       \d[2]x recomputed: \d\n',9,s_antialias9)
  881.     PrintF('       \d[2]x recomputed: \d\n',16,s_antialias16)
  882.     PrintF('       \d[2]x recomputed: \d\n',25,s_antialias25)
  883.     f:=320*240+(s_antialias4*4+s_antialias9*9+s_antialias16*16+s_antialias25*25)
  884.     f/=320*240
  885.     RealStr(str,f,4)
  886.     PrintF(' Each pixel was recomputed \s times.\n',str)
  887.     PrintF(' Rendering time: \d:\d (\d secs).\n',sec/60,sec\60,sec)
  888. ENDPROC
  889.  
  890. PROC main()
  891.     DEF    image:PTR TO RImage
  892.  
  893.     DEF    w:PTR TO Window,s:PTR TO Screen,vp,n=0,i
  894.     IF s:=OpenScreenTags(NIL,
  895.             SA_Width,320*2,
  896.             SA_Height,240*2,
  897.             SA_Depth,8,
  898.             SA_Title,'AmiRay Test Program',
  899.             SA_DisplayID,VGAPRODUCT_KEY,
  900.             SA_LikeWorkbench,TRUE,
  901.             TAG_END)
  902.         IF w:=OpenWindowTags(NIL,
  903.                 WA_InnerWidth,320*2,
  904.                 WA_InnerHeight,240*2,
  905.                 WA_Flags,WFLG_ACTIVATE|WFLG_RMBTRAP|WFLG_BORDERLESS|WFLG_GIMMEZEROZERO,
  906.                 WA_IDCMP,IDCMP_CLOSEWINDOW,
  907.                 WA_CustomScreen,s,
  908.                 TAG_END)
  909.             vp:=ViewPortAddress(w)
  910.             FOR i:=000 TO 063 SetRGB32(vp,n++,i<<26,0,0)
  911.             FOR i:=064 TO 127 SetRGB32(vp,n++,0,i<<26,0)
  912.             FOR i:=128 TO 191 SetRGB32(vp,n++,0,0,i<<26)
  913.             FOR i:=192 TO 255 SetRGB32(vp,n++,i<<26,i<<26,i<<26)
  914.  
  915.             IF image:=NewImage(320,240)
  916.                 Gen(image,w.RPort)
  917. //                Gen(image,NIL)
  918.                 SaveTarga(image)
  919.                 ShowInfo()
  920.                 WaitPort(w.UserPort)
  921.                 DeleteImage(image)
  922.             ENDIF
  923.  
  924.             CloseWindow(w)
  925.         ELSE PrintF('unable to open window!\n')
  926.         CloseScreen(s)
  927.     ELSE PrintF('unable to open screen!\n')
  928. ENDPROC
  929.